(*
 *  Haxe Compiler
 *  Copyright (c)2005-2007 Nicolas Cannasse
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)

open Ast
open Type
open Common

let is_native v =
	match v with
	| "Int"
	| "Float"
	| "String" ->
		true;
	| _ ->
		false;
;;

let to_native v =
	match v with
	| "Int" ->
		"int";
	| "Float" ->
		"float";
	| "String" ->
		"const char*";
	| _ ->
		print_string ("E: to_native(): \"" ^ v ^ "\" is NOT native.\n");
		"";
;;

(* into which place code can be generated (for classes/functions embedding, variables declarations and something else) *)
type tplace =
	
	(* used for type looking \sa find_first *)
	| PUndefined
	
	| PGlobal
	
	(* class' name *)
	| PClass of string
	
	(* field declaration or function implementation: field's name within class * true if public *)
	| PClassFieldDecl of Type.tclass_field
	
	(* declaring function parameters *)
	| PFunctionDecl
	
	(* true - function implementation generated, else otherwise - raise error *)
	| PFunctionImp of bool ref
	
	(* used to know if it's need to put semicolon after variable declaration or binary operation *)
	| PBlock
	| PVars
	| PBinop
	
	(* function call *)
	| PCall
	
	(* element "this" pointer *)
	| PThis
	
	(* field of some class, of "this" pointer, etc... *)
	| PField
	
	(* templates detection: count of already specified params *)
	| PInst of int ref
	
	(* to get rid of possible parent "PBlock" *)
	| PNew
	| PIf
	| PIf_true
	| PIf_false
	| PWhile_cond
	| PWhile_body
	| PSwitch_cond
	| PSwitch_body
	| PTry
	| PCatch
	| PReturn
	| PThrow
	
	(* main function - program entry-point *)
	| PMain
	
	(* class' constructor *)
	| PConstructor


type tfile = {
	
	(* where all includes is written - before any implementation code *)
	e : Buffer.t;
	(* where all implementation code is written - after includes *)
	i : Buffer.t;
	
	(* how deep indention is - each one is 2 spaces - refers to implementation code *)
	mutable ind : int;
}

(* code generation context *)
type tcontext = {
	
	(* into which header file all code is currently generating *)
	h : tfile;
	(* cpp output file *)
	c : tfile;
	
	(* current source placement stack *)
	p : (tplace) Stack.t;
	
	(* "include" list - classes, enumerations and something else what will be included to cpp file and declared within h file *)
	used_externs : Type.path Stack.t;
	
	mutable boost_ptr_used : bool;
}

let boost_ptr_used ctx =
	ctx.boost_ptr_used <- true;
;;

(* returns the first occurence of one of the types which "what_matching" matches looking them within ctx.p *)
let find_first ctx what_matching =
	
	let foundValue = ref PUndefined in
	let found = ref false in
	
	(* don't know how to interrupt "iter" function: *)
	Stack.iter ( fun e ->
		if not !found then
		begin
			if (what_matching e) then
			begin
				foundValue := e;
				found := true;
			end
		end
	) ctx.p;
	
	!foundValue
;;

let print_track o what =
	(* Buffer.add_string o.i what; *)
	()
;;

(* add another class or enum to the "include" list *)
let push_extern_usage ctx p =
	(* check if it already added *)
	let already = ref false in
	Stack.iter ( fun u ->
		(match u with
		| (l, n) ->
			(match p with
			| (pl, pn) ->
				if (String.compare n pn) = 0 then already := true;
				(* don't know how to break iteration - to use try/cath? isn't it slow? *)
			);
		);
	) ctx.used_externs;
	
	if not !already then
	begin
		Stack.push p ctx.used_externs;
	end;
;;

(* print current indention *)
let indent o =
	for i = 1 to o.ind do
		Buffer.add_string o.i "  ";
	done
;;

let rec type_str ctx o t = 
	
	match t with
	
	| TMono p ->
		
		print_track o ("&_TMono_&");
		
		(* don't know what it is but there are always two types in a row where first is a void, so remove this one *)
		(* Buffer.add_string o.i "void"; *)
		
		(match !p with
		| Some some ->
			type_str ctx o some;
		| None ->
			()
		);
	
	
	| TEnum (e, p) ->
		
		print_track o ("&_TEnum_&");
		
		(match e.e_path with
		| [], "Bool" ->
			Buffer.add_string o.i "bool";
		| [], "Void" ->
			Buffer.add_string o.i "void";
		| _ ->
			push_extern_usage ctx e.e_path;
			
			(* enums realy are just integers *)
			Buffer.add_string o.i "int";
		);
		
	
	| TInst (c, l) ->
		
		print_track o ("&_TInst_&");
		
		(* check if it is template param *)
		let template = ref false in
		(match Stack.top ctx.p with
		| PInst count ->
			if !count > 0 then Buffer.add_string o.i (", ");
			count := !count + 1;
			Buffer.add_string o.i ("< ");
			template := true;
		| _ ->
			()
		);
		
		let isBoostPtr = ref false in
		
		(match c.cl_path with
		| (l, s) ->
			if is_native(s) then
			(
				let native = to_native s in
				(* simulate native Array and String using proper substitutions *)
				(* push_extern_usage ctx (l, native); *)
				Buffer.add_string o.i native;
			)
			else
			(
				(* template arguments is not need to embrace into boost::ptr *)
				(match c.cl_kind with
				| KTypeParameter ->
					()
				| _ ->
					push_extern_usage ctx c.cl_path;
					
					isBoostPtr := true;
					ctx.boost_ptr_used <- true;
					Buffer.add_string o.i ("boost::shared_ptr< ");
					
					(* it's namespace (within normal class matching because template parameters have function's name within it's path ) *)
					List.iter ( fun f ->
						Buffer.add_string o.i (f ^ "::");
					) l;
				);
				
				(* it's name *)
				Buffer.add_string o.i s;
			)
		);
		
		if !template then Buffer.add_string o.i (" >");
		
		Stack.push (PInst(ref 0)) ctx.p;
		
		List.iter ( fun p ->
			type_str ctx o p;
		) l;
		
		(* close "boost::shared_ptr" template declaration *)
		if !isBoostPtr then Buffer.add_string o.i (" >");
		
		(match Stack.pop ctx.p with
		| PInst count ->
			()
		| _ ->
			print_string ("E: type_str(): TInst: stack corruption.\n");
		);
	
	
	| TType (p, v) ->
		
		print_track o ("&_TType_&");
		
		
	
	
	| TFun (someList, someT) ->
		
		print_track o ("&_TFun_&");
		
		List.iter ( fun e ->
			match e with
			| (someString, someBool, someAnotherT) ->
				print_string ("someString = " ^ someString ^ "\n");
		) someList;
		type_str ctx o someT;
	
	
	| TAnon p ->
		
		print_track o ("&_TAnon_&");
	
	
	| TDynamic p ->
		
		print_track o ("&_TDynamic_&");
	
	
	| TLazy p ->
		
		print_track o ("&_TLazy_&");
		type_str ctx o ((!p)());
	;
	
;;

let print_constant o c =
	(match c with
	| TInt i ->
		Buffer.add_string o (Int32.to_string i);
	| TFloat f ->
		Buffer.add_string o f;
	| TString s ->
		Buffer.add_char o '"';
		Buffer.add_string o (Ast.s_escape s);
		Buffer.add_char o '"';
	| TBool b ->
		if b then Buffer.add_string o "true" else Buffer.add_string o "false";
	| TNull ->
		Buffer.add_string o "NULL";
	| TThis ->
		Buffer.add_string o "this->";
	| _ ->
		print_string ("E: print_constant(): faced undefined constant type.\n");
		Buffer.add_string o "\"undefined\"";
	);
;;

let gen_param ctx o v co pc =
	
	type_str ctx o v.v_type;
	Buffer.add_string o.i " ";
	
	Buffer.add_string o.i v.v_name;
	
	if pc then
	begin
		(match co with
		| None ->
			()
		| Some c ->
			Buffer.add_string o.i (" = ");
			print_constant o.i c;
		);
	end;
;;

let gen_params ctx o l pc =
	let notFirst = ref false in
	List.iter ( fun (v, co) ->
		if !notFirst then Buffer.add_string o.i ", " else !notFirst <- true;
		gen_param ctx o v co pc;
	) l;
;;

(* print current indention if expression is within TBlock *)
let prefix ctx =
	(match Stack.top ctx.p with
	| PBlock ->
		indent ctx.c;
	| _ ->
		()
	)
;;

(* finish expression (print semicolon if expression is within TBlock) \sa newline *)
let postfix ctx =
	(match Stack.top ctx.p with
	| PBlock
	| PIf_true
	| PIf_false
	| PSwitch_body ->
		Buffer.add_string ctx.c.i (";");
	| _ ->
		()
	)
;;

let newline ctx =
	(match Stack.top ctx.p with
	| PBlock ->
		Buffer.add_string ctx.c.i ("\n");
	| _ ->
		()
	)
;;

(* some conditions has just one expression within it or code block - handle it properly *)
let face_block ctx expr =
	(match expr.eexpr with
	| TBlock _ ->
		Buffer.add_string ctx.c.i ("\n");
	| _ ->
		Buffer.add_string ctx.c.i (" ");
	);
;;

let print_namespace_usage b l =
	let notFirst = ref false in
	List.iter ( fun n ->
		if !notFirst then Buffer.add_string b ("::"); notFirst := true;
		Buffer.add_string b n;
	) l;
;;

let rec gen_expr ctx expr =
	
	(* Buffer.add_string ctx.c.i ("pfile: " ^ expr.epos.pfile ^ ", pmin: " ^ (string_of_int(expr.epos.pmin)) ^ ", pmax: " ^ (string_of_int(expr.epos.pmax)) ^ "\n"); *)
	
	(match expr.eexpr with
	
	| TConst (c) ->
		
		print_track ctx.c ("&_TConst_&");
		
		print_constant ctx.c.i c;
		
	
	| TLocal (v) ->
		
		print_track ctx.c ("&_TLocal_&");
		
		Buffer.add_string ctx.c.i v.v_name;
		
	
	| TEnumField (e, s) ->
		
		print_track ctx.c ("&_TEnumField_&");
		
		push_extern_usage ctx e.e_path;
		
		(match e.e_path with
		| (l, n) ->
			print_namespace_usage ctx.c.i l;
			Buffer.add_string ctx.c.i (n ^ "::");
		);
		Buffer.add_string ctx.c.i s;
	
	
	| TArray (e1, e2) ->
		
		print_track ctx.c ("&_TArray_&");
		
		gen_expr ctx e1;
		Buffer.add_string ctx.c.i "[";
		gen_expr ctx e2;
		Buffer.add_string ctx.c.i "]";
	
	
	| TBinop (b, e1, e2) ->
		
		print_track ctx.c ("&_TBinop_&");
		
		prefix ctx;
		
		Stack.push PBinop ctx.p;
		
		gen_expr ctx e1;
		Buffer.add_string ctx.c.i (" " ^ Ast.s_binop(b) ^ " ");
		gen_expr ctx e2;
		
		(match Stack.pop ctx.p with
		| PBinop ->
			()
		| _ ->
			print_string ("E: gen_expr(): TBinop: stack corruption.\n");
		);
		
		postfix ctx;
		newline ctx;
		
	
	| TField (e, s) ->
		
		print_track ctx.c ("&_TField_&");
		
		let dot = ref false in
		
		(match Stack.top ctx.p with
		| PBlock ->
			indent ctx.c;
		| PField ->
			dot := true;
		| _ ->
			()
		);
		
		Stack.push PField ctx.p;
		
		
		(* field's access (from "this", from other local object etc.) *)
		gen_expr ctx e;
		
		(* field's name *)
		Buffer.add_string ctx.c.i s;
		
		(* if current field is just storage of lower field, so print it's access' operator (boost::shared_ptr dereferencing for non-native types) *)
		if !dot then if is_native(s) then Buffer.add_string ctx.c.i "." else Buffer.add_string ctx.c.i "->";
		
		
		(match Stack.pop ctx.p with
		| PField ->
			()
		| _ ->
			print_string ("E: gen_expr(): TField: stack corruption.\n");
		);
		
		postfix ctx;
		newline ctx;
	
	
	| TClosure (e, s) ->
		
		print_track ctx.c ("&_TClosure_&");
		
		
	
	| TTypeExpr (m) ->
		
		print_track ctx.c ("&_TTypeExpr_&");
		
		(* was written in an attempt to implement "main" function generation - not needed yet *)
		(*
		(match m with
		| TClassDecl c ->
			print_track ctx.c ("&_TTypeExpr:TClassDecl_&");
			(match c.cl_path with
			| (l, s) ->
				print_track ctx.c ("&_TTypeExpr:TClassDecl:" ^ s ^ "_&");
			);
		| TEnumDecl e ->
			print_track ctx.c ("&_TTypeExpr:TEnumDecl_&");
		| TTypeDecl d ->
			print_track ctx.c ("&_TTypeExpr:TTypeDecl_&");
		);
		*)
	
	
	| TParenthesis (e) ->
		
		print_track ctx.c ("&_TParenthesis_&");
		
		prefix ctx;
		
		Buffer.add_string ctx.c.i ("(");
		gen_expr ctx e;
		Buffer.add_string ctx.c.i (")");
		
		newline ctx;
	
	
	| TObjectDecl (l) ->
		
		print_track ctx.c ("&_TObjectDecl_&");
		
		Buffer.add_string ctx.c.i ("TObjectDecl:");
		List.iter ( fun (s, e) ->
			Buffer.add_string ctx.c.i ("s = " ^ s);
			gen_expr ctx e;
		) l;
	
	
	| TArrayDecl (l) ->
		
		print_track ctx.c ("&_TArrayDecl_&");
		
		Buffer.add_string ctx.c.i ("[");
		
		let notFirst = ref false in
		List.iter ( fun e ->
			if !notFirst then Buffer.add_string ctx.c.i (", ") else notFirst := true;
			gen_expr ctx e;
		) l;
		
		Buffer.add_string ctx.c.i ("]");
	
	
	| TCall (e, l) ->
		
		print_track ctx.c ("&_TCall_&");
		
		prefix ctx;
		
		Stack.push PCall ctx.p;
		
		gen_expr ctx e;
		Buffer.add_string ctx.c.i ("(");
		let notFirst = ref false in
		List.iter ( fun e ->
			if !notFirst then Buffer.add_string ctx.c.i ", " else notFirst := true;
			gen_expr ctx e;
		) l;
		Buffer.add_string ctx.c.i (")");
		
		(match Stack.pop ctx.p with
		| PCall ->
			()
		| _ ->
			print_string ("E: gen_expr(): TCall: stack corruption.\n");
		);
		
		postfix ctx;
		newline ctx;
	
	
	| TNew (c, lp, le) ->
		
		print_track ctx.c ("&_TNew_&");
		
		(* some object can be created without any assignments *)
		prefix ctx;
		
		Stack.push PNew ctx.p;
		
		Buffer.add_string ctx.c.i ("boost::make_shared< ");
		
		(* class name *)
		push_extern_usage ctx c.cl_path;
		(match c.cl_path with
		| (l, s) ->
			print_namespace_usage ctx.c.i l;
			Buffer.add_string ctx.c.i s;
		);
		
		(* template parameters *)
		if (List.length lp) > 0 then
		begin
			Buffer.add_string ctx.c.i ("< ");
			
			let notFirst = ref false in
			List.iter ( fun p ->
				if !notFirst then Buffer.add_string ctx.c.i (", ") else notFirst := true;
				type_str ctx ctx.c p;
			) lp;
			
			Buffer.add_string ctx.c.i (" >");
		end;
		
		Buffer.add_string ctx.c.i (" >");
		
		Buffer.add_string ctx.c.i ("(");
		
		(* constructor parameters *)
		if (List.length le) > 0 then
		begin
					
			let notFirst = ref false in
			List.iter ( fun a ->
				if !notFirst then Buffer.add_string ctx.c.i (", ") else notFirst := true;
				gen_expr ctx a;
			) le;
			
		end;
		
		Buffer.add_string ctx.c.i (")");
		
		(match Stack.pop ctx.p with
		| PNew ->
			()
		| _ ->
			print_string ("E: gen_expr(): TNew: stack corruption.\n");
		);
		
		postfix ctx;
		newline ctx;
	
	
	| TUnop (u, uf, e) ->
		
		print_track ctx.c ("&_TUnop_&");
		
		prefix ctx;
		
		(match uf with
		| Ast.Prefix ->
			Buffer.add_string ctx.c.i (Ast.s_unop u);
			gen_expr ctx e;
		| Ast.Postfix ->
			gen_expr ctx e;
			Buffer.add_string ctx.c.i (Ast.s_unop u);
		);
		
		postfix ctx;
		newline ctx;
	
	
	| TFunction (f) ->
		
		print_track ctx.c ("&_TFunction_&");
		
		(match find_first ctx ( fun e -> (match e with | PClassFieldDecl _ | PMain -> true | _ -> false); ) with
		| PClassFieldDecl field ->
			
			let className = ref "" in
			(match find_first ctx ( fun e -> (match e with | PClass _ -> true | _ -> false); ) with
			| PClass n ->
				className := n;
			| _ ->
				print_string ("E: gen_expr(): TFunction: field: class was not found.\n");
			);
			
			let isConstructor = ref false in
			(match find_first ctx ( fun e -> (match e with | PClass _ | PConstructor -> true | _ -> false); ) with
			| PConstructor ->
				isConstructor := true;
			| _ ->
				()
			);
			
			(* declare function within header *)
			
			indent ctx.h;
			if field.cf_public then Buffer.add_string ctx.h.i "public:" else Buffer.add_string ctx.h.i "protected:";
			Buffer.add_string ctx.h.i (" ");
			(* constructor has class' name and does not return any value *)
			if !isConstructor then Buffer.add_string ctx.h.i !className
			else
			(
				type_str ctx ctx.h f.tf_type;
				Buffer.add_string ctx.h.i (" " ^ field.cf_name);
			);
			
			(* template arguments (if there are some) *)
			let notFirstTemplateArg = ref false in
			List.iter ( fun (s, tArg) ->
				if !notFirstTemplateArg then Buffer.add_string ctx.h.i (", ") else
				(
					notFirstTemplateArg := true;
					Buffer.add_string ctx.h.i ("< ");
				);
				
				(* it's just TInst: *)
				(match tArg with
				| TInst (c, l) ->
					(match c.cl_path with
					| (l, s) ->
						Buffer.add_string ctx.h.i s;
					);
				| _ ->
					()
				);
			) field.cf_params;
			if !notFirstTemplateArg then Buffer.add_string ctx.h.i (" >");
			
			Buffer.add_string ctx.h.i ("(");
			(* declare function parameters *)
			Stack.push PFunctionDecl ctx.p;
			gen_params ctx ctx.h f.tf_args true;
			(match Stack.pop ctx.p with
			| PFunctionDecl ->
				()
			| _ ->
				print_string ("E: gen_expt(): TFunction: decl: stack corruption.\n");
			);
			Buffer.add_string ctx.h.i (");\n");
			
			
			(* generate function into cpp file *)
			
			(* name with arguments *)
			indent ctx.c;
			if !isConstructor then Buffer.add_string ctx.c.i (!className ^ "::" ^ !className ^ "(")
			else
			(
				type_str ctx ctx.c f.tf_type;
				Buffer.add_string ctx.c.i (" " ^ !className ^ "::" ^ field.cf_name ^ "(");
			);
			gen_params ctx ctx.c f.tf_args false;
			Buffer.add_string ctx.c.i (")\n");
			
			(* body *)
			Stack.push (PFunctionImp (ref false)) ctx.p;
			gen_expr ctx f.tf_expr;
			(match Stack.pop ctx.p with
			| PFunctionImp b ->
				if not !b then print_string ("E: gen_epxr(): function \"" ^ field.cf_name ^ "\" without implementation.\n");
			| _ ->
				print_string ("E: gen_expr(): TFunction: imp: stack corruption.\n");
			);
		
		| PMain ->
			print_string ("I: gen_expr(): generating main function.\n");
			Buffer.add_string ctx.c.i ("&_EXPR_MAIN_&");
		| _ ->
			print_string ("E: gen_expr(): TFunction: no one proper context was found.\n");
		);
	
	
	| TVars (l) ->
		
		print_track ctx.c ("&_TVars_&");
		
		List.iter ( fun (v, o) ->
			
			prefix ctx;
			
			Stack.push PVars ctx.p;
			
			type_str ctx ctx.c v.v_type;
			
			Buffer.add_string ctx.c.i (" " ^ v.v_name);
			
			(match o with
			| None ->
				()
			| Some e ->
				Buffer.add_string ctx.c.i (" = ");
				gen_expr ctx e;
			);
			
			(match Stack.pop ctx.p with
			| PVars ->
				()
			| _ ->
				print_string ("E: gen_expr(): TVars: stack corruption.\n");
			);
			
			postfix ctx;
			newline ctx;
		) l;
	
	
	| TBlock (l) ->
		
		print_track ctx.c ("&_TBlock_&");
		
		indent ctx.c;
		Buffer.add_string ctx.c.i ("{\n");
		ctx.c.ind <- ctx.c.ind + 1;
		
		Stack.push PBlock ctx.p;
		
		List.iter ( fun e ->
			gen_expr ctx e;
		) l;
		
		(match Stack.pop ctx.p with
		| PBlock ->
			()
		| _ ->
			print_string ("E: gen_expr(): TBlock: stack corruption.\n");
		);
		
		ctx.c.ind <- ctx.c.ind - 1;
		indent ctx.c;
		Buffer.add_string ctx.c.i ("}");
		
		newline ctx;
		
		(* show that function implemented if there is some *)
		let f = Stack.top ctx.p in
		(match f with
		| PFunctionImp b ->
			b := true;
			
			Buffer.add_string ctx.c.i ("\n\n");
		| _ ->
			()
		);
	
	
	| TFor (v, e1, e2) ->
		
		print_track ctx.c ("&_TFor_&");
		
		(* this one never happens (for cicles are automatically broken into while cycles by HaXe compiler) - so all efforts are in vain *)
		(* prefix ctx;
		
		Buffer.add_string ctx.c.i ("for(int ");
		Buffer.add_string ctx.c.i v.v_name;
		Buffer.add_string ctx.c.i (" = ?; ");
		gen_expr ctx e1;
		Buffer.add_string ctx.c.i ("; " ^ v.v_name ^ "?)");
		gen_expr ctx e2;
		
		newline ctx; *)
	
	
	| TIf (e1, e2, o) ->
		
		print_track ctx.c ("&_TIf_&");
		
		prefix ctx;
		
		Buffer.add_string ctx.c.i ("if");
		
		(* condition *)
		Stack.push PIf ctx.p;
		gen_expr ctx e1;
		(match Stack.pop ctx.p with
		| PIf ->
			()
		| _ ->
			print_string ("E: gen_expr(): TIf: stack corruption.\n");
		);
		
		
		(* if true*)
		Stack.push PIf_true ctx.p;
		face_block ctx e2;
		gen_expr ctx e2;
		(match Stack.pop ctx.p with
		| PIf_true ->
			()
		| _ ->
			print_string ("E: gen_expr(): TIf: true: stack corruption.\n");
		);
		
		(* if false *)
		(match o with
		| None ->
			()
		| Some s ->
			Buffer.add_string ctx.c.i ("\n");
			prefix ctx;
			
			Stack.push PIf_false ctx.p;
			
			Buffer.add_string ctx.c.i ("else");
			face_block ctx s;
			gen_expr ctx s;
			
			(match Stack.pop ctx.p with
			| PIf_false ->
				()
			| _ ->
				print_string ("E: gen_expr(): TIf: false: stack corruption.\n");
			);
		);
		
		newline ctx;
	
	
	| TWhile (e1, e2, f) ->
		
		print_track ctx.c ("&_TWhile_&");
		
		prefix ctx;
		
		(match f with
		| Ast.NormalWhile ->
			Buffer.add_string ctx.c.i ("while");
			
			
			Stack.push PWhile_cond ctx.p;
			
			gen_expr ctx e1;
			
			(match Stack.pop ctx.p with
			| PWhile_cond ->
				()
			| _ ->
				print_string ("E: gen_expr(): TWhile: while cond: stack corruption.\n");
			);
			
			
			Stack.push PWhile_body ctx.p;
			
			face_block ctx e2;
			gen_expr ctx e2;
			
			(match Stack.pop ctx.p with
			| PWhile_body ->
				()
			| _ ->
				print_string ("E: gen_expr(): TWhile: while body: stack corruption.\n");
			);
			
		| Ast.DoWhile ->
			Buffer.add_string ctx.c.i ("do");
			
			
			Stack.push PWhile_body ctx.p;
			
			face_block ctx e2;
			gen_expr ctx e2;
			
			(match e2.eexpr with
			| TBlock _ ->
				Buffer.add_string ctx.c.i ("\n");
			| _ ->
				Buffer.add_string ctx.c.i ("; ");
			);
			
			(match Stack.pop ctx.p with
			| PWhile_body ->
				()
			| _ ->
				print_string ("E: gen_expr(): TWhile: do body: stack corruption.\n");
			);
			
			
			prefix ctx;
			Buffer.add_string ctx.c.i ("while");
			
			Stack.push PWhile_cond ctx.p;
			
			gen_expr ctx e1;
			Buffer.add_string ctx.c.i (";");
			
			(match Stack.pop ctx.p with
			| PWhile_cond ->
				()
			| _ ->
				print_string ("E: gen_expr(): TWhile: do cond: stack corruption.\n");
			);
		);
		
		newline ctx;
	
	
	| TSwitch (e, l, o) ->
		
		print_track ctx.c ("&_TSwitch_&");
		
		prefix ctx;
		
		
		(* condition *)
		
		Stack.push PSwitch_cond ctx.p;
		
		Buffer.add_string ctx.c.i ("switch");
		gen_expr ctx e;
		Buffer.add_string ctx.c.i ("\n");
		
		(match Stack.pop ctx.p with
		| PSwitch_cond ->
			()
		| _ ->
			print_string ("E: gen_expr(): TSwitch: cond: stack corruption.\n");
		);
		
		
		(* utility - called twice later *)
		let gen_case_body ctx expr =
			let withinBlock = ref false in
			(match expr.eexpr with
			| TBlock _ ->
				withinBlock := true;
				Buffer.add_string ctx.c.i "\n";
			| _ ->
				Buffer.add_string ctx.c.i (" ");
			);
			gen_expr ctx expr;
			if !withinBlock then
			begin
				Buffer.add_string ctx.c.i ("\n");
				indent ctx.c;
			end
			else Buffer.add_string ctx.c.i (" ");
			Buffer.add_string ctx.c.i "break;\n";
		in
		
		
		(* body *)
		
		(* open body *)
		prefix ctx;
		Buffer.add_string ctx.c.i ("{\n");
		(* increate indention for all cases *)
		ctx.c.ind <- ctx.c.ind + 1;
		Stack.push PSwitch_body ctx.p;
		List.iter ( fun (l, e) ->
			(* case (seems to be always just one value *)
			List.iter ( fun e ->
				indent ctx.c;
				Buffer.add_string ctx.c.i "case ";
				gen_expr ctx e;
				Buffer.add_string ctx.c.i ":";
			) l;
			
			(* case body *)
			gen_case_body ctx e;
		) l;
		(* default case - if there is some *)
		(match o with
		| None ->
			()
		| Some s ->
			indent ctx.c;
			Buffer.add_string ctx.c.i ("default:");
			gen_case_body ctx s;
		);
		(match Stack.pop ctx.p with
		| PSwitch_body ->
			()
		| _ ->
			print_string ("E: gen_expr(): TSwitch: body: stack corruption.\n");
		);
		(* back to previous indention *)
		ctx.c.ind <- ctx.c.ind - 1;
		(* close body *)
		prefix ctx;
		Buffer.add_string ctx.c.i ("}\n");
	
	
	| TMatch (e, ep, l, o) ->
		
		print_track ctx.c ("&_TMatch_&");
	
	
	| TTry (e, l) ->
		
		print_track ctx.c ("&_TTry_&");
		
		
		(* try *)
		
		prefix ctx;
		Buffer.add_string ctx.c.i ("try\n");
		
		Stack.push PTry ctx.p;
		
		(* this is always "TBlock" *)
		gen_expr ctx e;
		Buffer.add_string ctx.c.i ("\n");
		
		(match Stack.pop ctx.p with
		| PTry ->
			()
		| _ ->
			print_string ("E: gen_expr(): TTry: try: stack corruption.\n");
		);
		
		
		(* catch *)
		
		Stack.push PCatch ctx.p;
		
		List.iter ( fun (v, e) ->
			indent ctx.c;
			Buffer.add_string ctx.c.i ("catch(");
			type_str ctx ctx.c v.v_type;
			Buffer.add_string ctx.c.i (" " ^ v.v_name);
			Buffer.add_string ctx.c.i (")\n");
			
			(* this is always "TBlock" too *)
			gen_expr ctx e;
			Buffer.add_string ctx.c.i ("\n");
		) l;
		
		(match Stack.pop ctx.p with
		| PCatch ->
			()
		| _ ->
			print_string ("E: gen_expr(): TTry: catch: stack corruption.\n");
		);
	
	
	| TReturn (o) ->
		
		print_track ctx.c ("&_TReturn_&");
		
		prefix ctx;
		
		Buffer.add_string ctx.c.i "return";
		
		Stack.push PReturn ctx.p;
		
		(match o with
		| None ->
			()
		| Some s ->
			Buffer.add_string ctx.c.i " ";
			gen_expr ctx s;
		);
		
		(match Stack.pop ctx.p with
		| PReturn ->
			()
		| _ ->
			print_string ("E: gen_expr(): TReturn: stack corruption.\n");
		);
		
		postfix ctx;
		newline ctx;
	
	
	| TBreak ->
		
		print_track ctx.c ("&_TBreak_&");
		
		prefix ctx;
		
		Buffer.add_string ctx.c.i "break";
		
		postfix ctx;
		newline ctx;
	
	
	| TContinue ->
		
		print_track ctx.c ("&_TContinue_&");
		
		prefix ctx;
		
		Buffer.add_string ctx.c.i "continue";
		
		postfix ctx;
		newline ctx;
	
	
	| TThrow (e) ->
		
		print_string ("E: gen_expr(): TThrow: exceptions are not supported yet, sorry.\n");
		(*
		print_track ctx.c ("&_TThrow_&");
		
		prefix ctx;
		
		Stack.push PThrow ctx.p;
		
		Buffer.add_string ctx.c.i "throw ";
		gen_expr ctx e;
		
		(match Stack.pop ctx.p with
		| PThrow ->
			()
		| _ ->
			print_string ("E: gen_expr(): TThrow: stack corruption.\n");
		);
		
		postfix ctx;
		newline ctx;
		*)
	
	
	| TCast (e, o) ->
		print_track ctx.c ("&_TCast_&");
	);
;;

let generate_field ctx field = 
	
	Stack.push (PClassFieldDecl field) ctx.p;
	
	(match field.cf_kind with
	| Var vk ->
		
		print_track ctx.h "&_GEN_VAR_START_&";
		indent ctx.h;
		if field.cf_public then Buffer.add_string ctx.h.i "public:" else Buffer.add_string ctx.h.i "protected:";
		Buffer.add_string ctx.h.i " ";
		type_str ctx ctx.h field.cf_type;
		Buffer.add_string ctx.h.i (" " ^ field.cf_name ^ ";\n");
		print_track ctx.h "&_GEN_VAR_END_&";
		
	
	| Method mk ->
		
		(* (match mk with
		| MethNormal ->
			print_string "MethNormal\n";
		| MethInline ->
			print_string "MethInline\n";
		| MethDynamic ->
			print_string "MethDynamic\n";
		| MethMacro ->
			print_string "MethMacro\n";
		); *)
		
		(match field.cf_expr with
		| None ->
			print_string ("E: generate_field(): method: method \"" ^ field.cf_name ^ "\" does NOT have any expression.\n");
		| Some e ->
			gen_expr ctx e;
		);
		
	);
	
	(match Stack.pop ctx.p with
	| PClassFieldDecl _ ->
		()
	| _ ->
		print_string ("E: generate_field(): stack corruption.\n");
	);
;;

(* "some" is needed just to show that this is the function - don't know how to do it otherwise *)
let create_ctx some =
	let ctx = {
		h = {
			i = Buffer.create(16);
			e = Buffer.create(16);
			ind = 0;
		};
		
		c = {
			i = Buffer.create(16);
			e = Buffer.create(16);
			ind = 0;
		};
		
		p = Stack.create();
		
		used_externs = Stack.create();
		
		boost_ptr_used = false;
	} in
	ctx


let make_dir dir =
	try
		Unix.mkdir dir 0o755;
	with
	| Unix.Unix_error(e, s1, s2) ->
		(match e with
		| Unix.EEXIST ->
			()
		| _ ->
			print_string ("E: generate: call to \"Unix.mkdir\" failed with exception \"" ^ Unix.error_message e ^ "\".\n");
		);
	| e ->
		print_string ("E: generate: call to \"Unix.mkdir\" failed with undefined exception \"" ^ Printexc.to_string e ^ "\".\n");
;;

(* forms path (ending with "/") to the "pack" relative to com.file and creates each folder on it's path *)
let form_path com pack =
	let currentPath = ref "" in
	List.iter ( fun package ->
		!currentPath <- !currentPath ^ package ^ "/";
		let dir = com.file ^ !currentPath in
		if not (Sys.file_exists dir) then make_dir dir;
	) pack;
	!currentPath
;;

let haxe_intro = "/**\nThis file is generated using the HaXe compiler from *.hx sources.\nVisit http://haxe.org/ for more info.\nIf you need to modify this file - modify it's sources instead.\n**/\n\n"
;;

let namespace_start b path =
	let wasSome = ref false in
	List.iter ( fun n ->
		Buffer.add_string b ("namespace " ^ n ^ " {\n");
		wasSome := true;
	) path;
	if !wasSome then Buffer.add_string b "\n";
;;

let namespace_end b path =
	let wasSome = ref false in
	List.iter ( fun n ->
		Buffer.add_string b ("}\n");
		wasSome := true;
	) path;
	if !wasSome then Buffer.add_string b "\n";
;;

(* generates lock to avoid multiple file's definitions *)
let gen_lock pack name =
	let lockName = ref "" in
	List.iter ( fun pack ->
		!lockName <- !lockName ^ pack ^ "__";
	) pack;
	!lockName <- !lockName ^ name ^ "_H";
	!lockName <- String.uppercase !lockName;
	!lockName
;;

let lock_start lockName =
	"#ifndef " ^ lockName ^ "\n#define " ^ lockName ^ "\n\n"
;;

let lock_end lockName =
	"#endif//#ifndef " ^ lockName ^ "\n\n"
;;

let generate_enum com e pack name =
	(* print_string ("I: generate_enum(): generating enum \"" ^ name ^ "\".\n"); *)
	
	let header = open_out (com.file ^ (form_path com pack) ^ name ^ ".h") in
	output_string header haxe_intro;
	
	let lockName = gen_lock pack name in
	output_string header (lock_start lockName);
	
	let ctx = create_ctx true in
	
	(* List.iter ( fun (s, t) ->
		Buffer.add_string ctx.h.i ("    enum type: " ^ s ^ ":\n");
		type_str ctx ctx.h t;
	) e.e_types; *)
	
	namespace_start ctx.h.i pack;
	
	(* open class *)
	Buffer.add_string ctx.h.i ("class " ^ name ^ "\n{\npublic:\n");
	ctx.h.ind <- ctx.h.ind + 1;
	
	(* open enum *)
	indent ctx.h;
	Buffer.add_string ctx.h.i ("enum\n");
	indent ctx.h;
	Buffer.add_string ctx.h.i ("{\n");
	ctx.h.ind <- ctx.h.ind + 1;
	
	let currentIndex = ref 0 in
	PMap.iter ( fun i1 i2 ->
		PMap.iter ( fun k ef ->
			if !currentIndex = ef.ef_index then
			begin
				indent ctx.h;
				Buffer.add_string ctx.h.i (ef.ef_name ^ ",\n");
			end
		) e.e_constrs;
		currentIndex := !currentIndex + 1;
	) e.e_constrs;
	
	(* close enum *)
	ctx.h.ind <- ctx.h.ind - 1;
	indent ctx.h;
	Buffer.add_string ctx.h.i ("};\n");
	
	(* close class *)
	Buffer.add_string ctx.h.i ("};\n\n");
	
	namespace_end ctx.h.i pack;
	
	(* List.iter ( fun n ->
		Buffer.add_string ctx.h.i ("    name: \"" ^ n ^ "\".\n");
	) e.e_names; *)
	
	Buffer.output_buffer header ctx.h.i;
	
	output_string header (lock_end lockName);
;;


let generate_class com c pack name =
	
	(* print_string ("I: generate_class(): generating class \"" ^ name ^ "\".\n"); *)
	
	let fullFileName = com.file ^ (form_path com pack) ^ name in
	
	let header = open_out (fullFileName ^ ".h") in
	let cpp = open_out (fullFileName ^ ".cpp") in
	
	let ctx = create_ctx true in
	
	(* file's commentary *)
	output_string header haxe_intro;
	output_string cpp haxe_intro;
	
	let lockName = gen_lock pack name in
	output_string header (lock_start lockName);
	
	(* class itself *)
	
	namespace_start ctx.h.i pack;
	
	(* file's definition start *)
	Buffer.add_string ctx.h.i ("class " ^ name);
	(* parents *)
	(* ... *)
	Buffer.add_string ctx.h.i "\n";
	Buffer.add_string ctx.h.i "{\n";
	
	ctx.h.ind <- ctx.h.ind + 1;
	Stack.push (PClass name) ctx.p;
	
	(* constructor *)
	Stack.push (PConstructor) ctx.p;
	(match c.cl_constructor with
	| None ->
		()
	| Some f ->
		generate_field ctx f;
	);
	(match Stack.pop ctx.p with
	| PConstructor ->
		()
	| _ ->
		print_string ("E: generate_class(): constructor: stack corruption.\n");
	);
	
	(* fields *)
	PMap.iter ( fun key field ->
		
		generate_field ctx field;
		
	) c.cl_fields;
	
	ctx.h.ind <- ctx.h.ind - 1;
	
	
	(* file's definition's end *)
	Buffer.add_string ctx.h.i ("};\n\n");
	
	(match Stack.pop ctx.p with
	| PClass _ ->
		()
	| _ ->
		print_string ("E: generate_class(): stack corruption.\n");
	);
	
	namespace_end ctx.h.i pack;
	
	
	(* finally print everything generated into physical file *)
	
	(* include header within cpp *)
	output_string cpp ("#include \"" ^ name ^ ".h\"\n\n");
	
	(* declare used classes and any externs for cross including - classes declarations into header and files into cpp *)
	if ctx.boost_ptr_used then output_string header ("#include <boost/shared_ptr.hpp>\n#include <boost/make_shared.hpp>\n\n");
	Stack.iter ( fun p ->
		(match p with
		| (l, s) ->
			output_string cpp ("#include \"");
			
			(* folders and namespaces *)
			let brackets = ref 0 in
			List.iter ( fun f ->
				output_string header ("namespace " ^ f ^ " { ");
				brackets := !brackets + 1;
				
				output_string cpp (f ^ "/");
			) l;
			
			output_string header ("class " ^ s ^ ";");
			(for i = 1 to !brackets do
				output_string header(" }");
			done);
			output_string header ("\n");
			
			output_string cpp (s ^ ".h\"\n");
		);
	) ctx.used_externs;
	output_string header ("\n");
	output_string cpp ("\n\n");
	
	(* implementation *)
	Buffer.output_buffer header ctx.h.i;
	Buffer.output_buffer cpp ctx.c.i;
	
	
	
	
	(* file's lock's end *)
	output_string header (lock_end lockName);
	
	close_out header;
	close_out cpp;
;;


let generate com =
	
	(* assuming that target folder is always ends with slash: such as "/path/to/target/folder/": *)
	if com.file.[String.length com.file - 1] <> '/' then com.file <- (com.file ^ "/");
	
	print_string ("I: Generating C++ native code into directory \"" ^ com.file ^ "\"...\n");
	
	make_dir com.file;
	
	List.iter (fun t ->
		match t with
		| TClassDecl c ->
			(match c.cl_path with
			| (pack, name) ->
				
				(match pack with
				| ["haxe"] -> 
					
					(match name with
					(* skip *)
					| "Log" ->
						()
					| _ ->
						generate_class com c pack name;
					);
				
				| [] ->
					
					(match name with
					(* skip the following default types - they are default types within target platforms itself: *)
					| "Int"
					| "Float"
					| "String"
					| "Dynamic"
				 	| "Array"
					| "ArrayAccess"
					| "Std"
					| "IntIter" ->
						(* skipped ... *)
						()
					| _ ->
						generate_class com c pack name;
						
					);
				
				| _ ->
					
					generate_class com c pack name;
				
				);
			);
			
		| TEnumDecl e ->
			(match e.e_path with
			| (pack, name) ->
				(match pack with
				| ["haxe"] ->
					generate_enum com e pack name;
				| [] ->
					(match name with
					| "Void"
					| "Bool" ->
						()
					| _ ->
						generate_enum com e pack name;
					);
				| _ ->
					generate_enum com e pack name;
				);
			);
		
		| TTypeDecl t ->
			()
	) com.types;
	
	
	(* we'll live without main for now *)
	(*
	(* main *)
	(match com.main with
	| None ->
		print_string ("I: generate(): no main.\n");
	| Some m ->
		let cpp = open_out ( com.file ^ "main.cpp") in
		let ctx = create_ctx true in
		
		(* generating *)
		Stack.push PMain ctx.p;
		gen_expr ctx m;
		(match Stack.pop ctx.p with
		| PMain ->
			()
		| _ ->
			print_string ("E: generate(): main: stack corrupion.\n");
		);
		
		(* writing into file *)
		Buffer.output_buffer cpp ctx.c.i;
		
		close_out cpp;
	);
	*)
	
	
	print_string "I: C++ native code generation completed.\n";
	
;;



